home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / lisp / ada.elc < prev    next >
Text File  |  1992-02-21  |  16KB  |  201 lines

  1.  
  2. (setq auto-mode-alist (cons (cons "\\.ada$" (quote ada-mode)) auto-mode-alist))
  3.  
  4. (defvar ada-mode-syntax-table nil "\
  5. Syntax table in use in Ada-mode buffers.")
  6.  
  7. (let ((table (make-syntax-table))) (modify-syntax-entry 95 "_" table) (modify-syntax-entry 35 "_" table) (modify-syntax-entry 40 "()" table) (modify-syntax-entry 41 ")(" table) (modify-syntax-entry 36 "." table) (modify-syntax-entry 42 "." table) (modify-syntax-entry 47 "." table) (modify-syntax-entry 43 "." table) (modify-syntax-entry 45 "." table) (modify-syntax-entry 61 "." table) (modify-syntax-entry 38 "." table) (modify-syntax-entry 124 "." table) (modify-syntax-entry 60 "." table) (modify-syntax-entry 62 "." table) (modify-syntax-entry 91 "." table) (modify-syntax-entry 93 "." table) (modify-syntax-entry 123 "." table) (modify-syntax-entry 125 "." table) (modify-syntax-entry 46 "." table) (modify-syntax-entry 92 "." table) (modify-syntax-entry 58 "." table) (modify-syntax-entry 59 "." table) (modify-syntax-entry 39 "." table) (modify-syntax-entry 34 "\"" table) (setq ada-mode-syntax-table table))
  8.  
  9. (defvar ada-mode-map nil "\
  10. Keymap used in Ada mode.")
  11.  
  12. (let ((map (make-sparse-keymap))) (define-key map "" (quote ada-newline)) (define-key map "" (quote backward-delete-char-untabify)) (define-key map "    " (quote ada-tab)) (define-key map "    " (quote ada-untab)) (define-key map "<" (quote ada-backward-to-same-indent)) (define-key map ">" (quote ada-forward-to-same-indent)) (define-key map "h" (quote ada-header)) (define-key map "(" (quote ada-paired-parens)) (define-key map "-" (quote ada-inline-comment)) (define-key map "" (quote ada-array)) (define-key map "b" (quote ada-exception-block)) (define-key map "d" (quote ada-declare-block)) (define-key map "" (quote ada-exception)) (define-key map "c" (quote ada-case)) (define-key map " " (quote ada-package-spec)) (define-key map "k" (quote ada-package-body)) (define-key map "" (quote ada-procedure-spec)) (define-key map "p" (quote ada-subprogram-body)) (define-key map "" (quote ada-function-spec)) (define-key map "f" (quote ada-for-loop)) (define-key map "l" (quote ada-loop)) (define-key map "i" (quote ada-if)) (define-key map "I" (quote ada-elsif)) (define-key map "e" (quote ada-else)) (define-key map "" (quote ada-private)) (define-key map "" (quote ada-record)) (define-key map "" (quote ada-subtype)) (define-key map "s" (quote ada-separate)) (define-key map "" (quote ada-type)) (define-key map "t" (quote ada-tabsize)) (define-key map "w" (quote ada-while-loop)) (define-key map "" (quote ada-when)) (define-key map "x" (quote ada-exit)) (define-key map "C" (quote ada-compile)) (define-key map "B" (quote ada-bind)) (define-key map "E" (quote ada-find-listing)) (define-key map "L" (quote ada-library-name)) (define-key map "O" (quote ada-options-for-bind)) (setq ada-mode-map map))
  13.  
  14. (defvar ada-indent 4 "\
  15. *Value is the number of columns to indent in Ada-Mode.")
  16.  
  17. (defun ada-mode nil "\
  18. This is a mode intended to support program development in Ada.
  19. Most control constructs and declarations of Ada can be inserted in the buffer
  20. by typing Control-C followed by a character mnemonic for the construct.
  21.  
  22. C-c C-a  array             C-c b    exception block
  23. C-c C-e  exception      C-c d    declare block
  24. C-c C-k  package spec   C-c k    package body
  25. C-c C-p  procedure spec C-c p    proc/func body
  26. C-c C-f  func spec      C-c f    for loop
  27.                         C-c i    if
  28.                         C-c I    elsif
  29.                         C-c e    else
  30. C-c C-v  private        C-c l    loop
  31. C-c C-r  record         C-c c    case
  32. C-c C-s  subtype        C-c s    separate
  33. C-c C-t  type           C-c t    tab spacing for indents
  34. C-c C-w  when           C-c w    while
  35.                         C-c x    exit
  36. C-c (    paired parens  C-c -    inline comment
  37.                         C-c h    header sec
  38. C-c C    compile        C-c B    bind
  39. C-c E    find error list
  40. C-c L    name library   C-c O    options for bind
  41.  
  42. C-c < and C-c > move backward and forward respectively to the next line
  43. having the same (or lesser) level of indentation.
  44.  
  45. Variable ada-indent controls the number of spaces for indent/undent.
  46.  
  47. \\{ada-mode-map}
  48. " (interactive) (byte-code "шҠˆÓ!ˆÔ‰ˆÕ‰ˆÖÃ!ˆ×‰ˆÖÄ!ˆØ‰ˆÙ!ˆÖÆ!ˆÚP‰ˆÖÈ!ˆ‰ˆÖÉ!ˆÊ‰    ˆÖË!ˆÊ‰ ˆÖÌ!ˆÛ‰ ˆÖÍ!ˆÜ‰ˆÖÃ!ˆ×‰ˆÖÎ!ˆÝ‰ˆÖÏ!ˆÞ‰ˆÖÐ!ˆÊ‰ˆßà!‡" [ada-mode-map major-mode mode-name comment-column end-comment-column ada-mode-syntax-table paragraph-start page-delimiter paragraph-separate paragraph-ignore-fill-prefix t require-final-newline comment-start comment-end comment-start-skip comment-indent-hook parse-sexp-ignore-comments nil kill-all-local-variables use-local-map ada-mode "Ada" make-local-variable 41 72 set-syntax-table "^$\\|" "--" "
  49. " "--+ *" c-comment-indent run-hooks ada-mode-hook] 17))
  50.  
  51. (defun ada-tabsize (s) "\
  52. changes spacing used for indentation. Reads spacing from minibuffer." (interactive "nnew indentation spacing: ") (byte-code "ˆ    ‰‡" [ada-indent s nil] 2))
  53.  
  54. (defun ada-newline nil "\
  55. Start new line and indent to current tab stop." (interactive) (byte-code "ÁˆÂ àˆj)‡" [ada-cc nil current-indentation newline] 3))
  56.  
  57. (defun ada-tab nil "\
  58. Indent to next tab stop." (interactive) (byte-code "ÁˆÂÃÄ \"T\"j‡" [ada-indent nil * / current-indentation] 5))
  59.  
  60. (defun ada-untab nil "\
  61. Delete backwards to previous tab stop." (interactive) (byte-code "ÁˆÂÁ\"‡" [ada-indent nil backward-delete-char-untabify] 3))
  62.  
  63. (defun ada-go-to-this-indent (step indent-level) "\
  64. Move point repeatedly by <step> lines till the current line
  65. has given indent-level or less, or the start/end of the buffer is hit.
  66. Ignore blank lines, statement labels, block/loop names." (byte-code "ÃÄ!!…$ÅÆ!†$ÅÇ!†$ÅÈ!†$ÅÉ!†$Ê     V…,ˆ‚‡" [step indent-level nil zerop forward-line looking-at "^[     ]*$" "^[     ]*--" "^<<[A-Za-z0-9_]+>>" "^[A-Za-z0-9_]+:" current-indentation] 9))
  67.  
  68. (defun ada-backward-to-same-indent nil "\
  69. Move point backwards to nearest line with same indentation or less.
  70. If not found, point is left at top of buffer." (interactive) (byte-code "ÀˆÁÂà\"ˆÄ ‡" [nil ada-go-to-this-indent -1 current-indentation back-to-indentation] 4))
  71.  
  72. (defun ada-forward-to-same-indent nil "\
  73. Move point forwards to nearest line with same indentation or less.
  74. If not found, point is left at start of last line in buffer." (interactive) (byte-code "ÀˆÁÂà\"ˆÄ ‡" [nil ada-go-to-this-indent 1 current-indentation back-to-indentation] 4))
  75.  
  76. (defun ada-array nil "\
  77. Insert array type definition, prompting for component type,
  78. leaving the user to type in the index subtypes." (interactive) (byte-code "ÀˆÁcˆÂ ˆÃÄ!cˆÅ ˆÆcˆÂ ˆÃÇ!cˆÅ ‡" [nil "array ()" backward-char read-string "index subtype[s]: " end-of-line " of ;" "component-type: "] 7))
  79.  
  80. (defun ada-case nil "\
  81. Build skeleton case statment, prompting for the selector expression.
  82. starts up the first when clause, too." (interactive) (byte-code "ÀˆÁcˆÂÃÄ!Å\"ˆÆ ˆÆ ˆÇcˆÈÉ!ˆÊ ˆÊ ˆË ‡" [nil "case " insert read-string "selector expression: " " is" ada-newline "end case;" end-of-line 0 ada-tab ada-when] 9))
  83.  
  84. (defun ada-declare-block nil "\
  85. Insert a block with a declare part and indent for the 1st declaration." (interactive) (byte-code "ÁˆÂÃ!ÄcˆÅÆ\"?…#Ç ˆÈÉ!ˆÊË\"ˆÌÉ!ˆÍ ˆÎ ˆÎ ˆÏcˆÎ ˆÎ ˆÅÆ\"ƒ?Ðc‚DÊÑÒ#)ˆÍÓ!ˆÔ ‡" [ada-block-name nil read-string "[block name]: " "declare" string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line ada-newline "begin" "end;" "end " ";" -2 ada-tab] 16))
  86.  
  87. (defun ada-exception-block nil "\
  88. Insert a block with an exception part and indent for the 1st line of code." (interactive) (byte-code "ˆÃÄ!ÅcˆÆÇ\"?…#È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎ ˆÏ ˆÏ ˆÐcˆÏ ˆÏ ˆÆÇ\"ƒ?Ñc‚DËÒÓ#)ˆÎÔ!ˆÕ ‡" [block-name t nil read-string "[block name]: " "begin" string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line ada-newline "exception" "end;" "end " ";" -2 ada-tab] 16))
  89.  
  90. (defun ada-exception nil "\
  91. Undent and insert an exception part into a block. Reindent." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "exception" ada-newline ada-tab] 4))
  92.  
  93. (defun ada-else nil "\
  94. Add an else clause inside an if-then-end-if clause." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "else" ada-newline ada-tab] 4))
  95.  
  96. (defun ada-exit nil "\
  97. Insert an exit statement, prompting for loop name and condition." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?…ÈÉ\")ˆÄÊ!Æ    Ç\"?…5ËÌ    \"ƒ1ÈÉ    \"‚5ÈÍ    \")ˆÎc‡" [ada-loop-name ada-exit-condition nil "exit" read-string "[name of loop to exit]: " string-equal "" insert " " "[exit condition]: " string-match "^ *[Ww][Hh][Ee][Nn] +" " when " ";"] 10))
  98.  
  99. (defun ada-when nil "\
  100. Start a case statement alternative with a when clause." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃÄÅ!Æ\"ˆÇ ˆÈ ‡" [nil ada-untab "when " insert read-string "'|'-delimited choice list: " " =>" ada-newline ada-tab] 6))
  101.  
  102. (defun ada-for-loop nil "\
  103. Build a skeleton for-loop statement, prompting for the loop parameters." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?    …&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆËÄÏ!Ð\"ˆËÄÑ!Ò\"ˆÓ ˆÓ ˆÔcˆ    …FËÕ\"ˆÖc*ˆÎ×!ˆØ ‡" [ada-loop-name ada-loop-is-named nil "for " read-string "[loop name]: " string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line "loop variable: " " in " "range: " " loop" ada-newline "end loop" " " ";" 0 ada-tab] 17))
  104.  
  105. (defun ada-header nil "\
  106. Insert a comment block containing the module title, author, etc." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄÅÆ \"ˆÄÇÈ \"ˆÄÉÊ ËÌ Í%‡" [nil "--
  107. --  Title:     " read-string "Title: " insert "
  108. --  Created:    " current-time-string "
  109. --  Author:     " user-full-name "
  110. --        <" user-login-name "@" system-name ">
  111. --
  112. "] 13))
  113.  
  114. (defun ada-if nil "\
  115. Insert skeleton if statment, prompting for a boolean-expression." (interactive) (byte-code "ÀˆÁcˆÂÃÄ!Å\"ˆÆ ˆÆ ˆÇcˆÈÉ!ˆÊ ‡" [nil "if " insert read-string "condition: " " then" ada-newline "end if;" end-of-line 0 ada-tab] 7))
  116.  
  117. (defun ada-elsif nil "\
  118. Add an elsif clause to an if statement, prompting for the boolean-expression." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃÄÅ!Æ\"ˆÇ ˆÈ ‡" [nil ada-untab "elsif " insert read-string "condition: " " then" ada-newline ada-tab] 6))
  119.  
  120. (defun ada-loop nil "\
  121. insert a skeleton loop statement.  exit statement added by hand." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?    …&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆÏ ˆÏ ˆÐcˆ    …8ËÑ\"ˆÒc*ˆÎÓ!ˆÔ ‡" [ada-loop-name ada-loop-is-named nil "loop " read-string "[loop name]: " string-equal "" beginning-of-line open-line 1 insert ":" forward-line end-of-line ada-newline "end loop" " " ";" 0 ada-tab] 13))
  122.  
  123. (defun ada-package-spec nil "\
  124. Insert a skeleton package specification." (interactive) (byte-code "ÁˆÂcˆÃÄ!ÅÆ\"ˆÇ ˆÇ ˆÅÈÉ#ˆÊË!ˆÌ )‡" [ada-package-name nil "package " read-string "package name: " insert " is" ada-newline "end " ";" end-of-line 0 ada-tab] 8))
  125.  
  126. (defun ada-package-body nil "\
  127. Insert a skeleton package body --  includes a begin statement." (interactive) (byte-code "ÁˆÂcˆÃÄ!ÅÆ\"ˆÇ ˆÇ ˆÈcˆÇ ˆÅÉÊ#ˆËÌ!ˆÍ )‡" [ada-package-name nil "package body " read-string "package name: " insert " is" ada-newline "begin" "end " ";" end-of-line -1 ada-tab] 9))
  128.  
  129. (defun ada-private nil "\
  130. Undent and start a private section of a package spec. Reindent." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "private" ada-newline ada-tab] 4))
  131.  
  132. (defun ada-get-arg-list nil "\
  133. Read from user a procedure or function argument list.
  134. Add parens unless arguments absent, and insert into buffer.
  135. Individual arguments are arranged vertically if entered one-at-a-time.
  136. Arguments ending with ';' are presumed single and stacked." (byte-code "ÂcˆiÃÄ!Å    Æ\"ƒÇÈ!‚4ÉÊ    \"…/    cˆË ˆjˆÃÌ!‰ˆ‚ˆÍ    Î\"*‡" [ada-arg-indent ada-args " (" read-string "[arguments]: " string-equal "" backward-delete-char 2 string-match ";$" newline "next argument: " insert ")"] 9))
  137.  
  138. (defun ada-function-spec nil "\
  139. Insert a function specification.  Prompts for name and arguments." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄ ˆÅcˆÂÆ!c‡" [nil "function " read-string "function name: " ada-get-arg-list " return " "result type: "] 4))
  140.  
  141. (defun ada-procedure-spec nil "\
  142. Insert a procedure specification, prompting for its name and arguments." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄ ‡" [nil "procedure " read-string "procedure name: " ada-get-arg-list] 3))
  143.  
  144. (defun get-ada-subprogram-name nil "\
  145. Return (without moving point or mark) a pair whose CAR is
  146. the name of the function or procedure whose spec immediately precedes point,
  147. and whose CDR is the column nbr the procedure/function keyword was found at." (byte-code "ŠÄÅÆÁÂ#ƒ4ÇÈ!†ÇÉ!ƒ/i‰ˆÊË!ˆ`ÊÌ!ˆÍ` \"B)‚1Π‚7ÏB))‡" [ada-proc-indent nil t p2 0 re-search-backward "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>" "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>" forward-word 2 -1 buffer-substring get-ada-subprogram-name "NAME?"] 9))
  148.  
  149. (defun ada-subprogram-body nil "\
  150. Insert frame for subprogram body.
  151. Invoke right after ada-function-spec or ada-procedure-spec." (interactive) (byte-code "ÁˆÂcˆÃ Ä ˆAjˆÅ ˆÆcˆÅ ˆÅ ˆÇÈ@É#)ˆÊË!ˆÌ ‡" [ada-subprogram-name-col nil " is" get-ada-subprogram-name newline ada-newline "begin" insert "end " ";" end-of-line -2 ada-tab] 9))
  152.  
  153. (defun ada-separate nil "\
  154. Finish a body stub with 'is separate'." (interactive) (byte-code "ÀˆÁcˆÂ ˆÃ ˆÄcˆÂ ˆÅ ‡" [nil " is" ada-newline ada-tab "separate;" ada-untab] 5))
  155.  
  156. (defun ada-record nil "\
  157. Insert a skeleton record type declaration." (interactive) (byte-code "ÀˆÁcˆÂ ˆÂ ˆÃcˆÄÅ!ˆÆ ‡" [nil "record" ada-newline "end record;" end-of-line 0 ada-tab] 5))
  158.  
  159. (defun ada-subtype nil "\
  160. Start insertion of a subtype declaration, prompting for the subtype name." (interactive) (byte-code "ÀˆÁÂÃÄ!Å#ˆÆ ˆÇÈ!‡" [nil insert "subtype " read-string "subtype name: " " is ;" backward-char message "insert subtype indication."] 5))
  161.  
  162. (defun ada-type nil "\
  163. Start insertion of a type declaration, prompting for the type name." (interactive) (byte-code "ÁˆÂÃÄÅ!\"ˆÄÆ!ÇÈ\"?…ÂÉÊ#)ˆËcˆÌÍ!‡" [disc-part nil insert "type " read-string "type name: " "discriminant specs: " string-equal "" "(" ")" " is " message "insert type definition."] 8))
  164.  
  165. (defun ada-while-loop nil (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?    …&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆËÄÏ!Ð\"ˆÑ ˆÑ ˆÒcˆ    …?ËÓ\"ˆÔc*ˆÎÕ!ˆÖ ‡" [ada-loop-name ada-loop-is-named nil "while " read-string "loop name: " string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line "entry condition: " " loop" ada-newline "end loop" " " ";" 0 ada-tab] 15))
  166.  
  167. (defun ada-paired-parens nil "\
  168. Insert a pair of round parentheses, placing point between them." (interactive) (byte-code "ÀˆÁcˆÂ ‡" [nil "()" backward-char] 2))
  169.  
  170. (defun ada-inline-comment nil "\
  171. Start a comment after the end of the line, indented at least COMMENT-COLUMN.
  172. If starting after END-COMMENT-COLUMN, start a new line." (interactive) (byte-code "ˆàˆiV…Ä ˆi    W…    jˆÅc‡" [end-comment-column comment-column nil end-of-line newline " -- "] 4))
  173.  
  174. (defun ada-display-comment nil "\
  175. Inserts 3 comment lines, making a display comment." (interactive) (byte-code "ÀˆÁcˆÂÃ!‡" [nil "--
  176. -- 
  177. --" end-of-line 0] 2))
  178.  
  179. (defvar ada-lib-dir-name "lib" "\
  180. *Current ada program library directory.")
  181.  
  182. (defvar ada-bind-opts "" "\
  183. *Options to supply for binding.")
  184.  
  185. (defun ada-library-name (ada-lib-name) "\
  186. Specify name of ada library directory for later compilations." (interactive "Dname of ada library directory: ") (byte-code "ˆ    ‰‡" [ada-lib-dir-name ada-lib-name nil] 2))
  187.  
  188. (defun ada-options-for-bind nil "\
  189. Specify options, such as -m and -i, needed for adabind." (byte-code "ÁÂ!‰‡" [ada-bind-opts read-string "-m and -i options for adabind: "] 3))
  190.  
  191. (defun ada-compile (ada-prefix-arg) "\
  192. Save the current buffer and compile it into the current program library.
  193. Initialize the library if a prefix arg is given." (interactive "P") (byte-code "Ĉ    ?ƒ ł ÆÇ ÈÉÊË Ì
  194. &!*‡" [ada-init ada-prefix-arg ada-source-file ada-lib-dir-name nil "" "-n " buffer-name compile concat "adacomp " "-l " " "] 9))
  195.  
  196. (defun ada-find-listing nil "\
  197. Find listing file for ada source in current buffer, using other window." (interactive) (byte-code "ÀˆÁ ÃÄOÅP!ˆÆÇ!‡" [nil find-file-other-window buffer-name 0 -4 ".lis" search-forward "*** ERROR"] 5))
  198.  
  199. (defun ada-bind nil "\
  200. Bind the current program library, using the current binding options." (interactive) (byte-code "ˆÃÄÅ    R!‡" [ada-bind-opts ada-lib-dir-name nil compile "adabind " " "] 5))
  201.